Network Supervisor's Toolkit/Network Supervisor's Toolkit.iso/printers/net_prnt/net_prin.pas

Pascal/Delphi Source File | 1996-07-10 | 12KB | 451 lines

Program Novell_Printing_Example;

USES   DOS, CRT,  Unit_Sup;

{      Author:  Rick Ryan
  Info Source: Novell API Reference, Volume I

  Demonstration of printing on Novell Advanced Netware 2.1+ using named
  Print Queues and Servers.

  This method is required if you are using third party local printer sharing
  software like Brightwork's PS-Print Plus since it is not possible to
  assign a Netware Spooled Printer Number to one of these Queues.

  With Netware 2.1 the concept of printing changed so that queues are used
  in place of Spooled Printers.  Spooled printers are still available, but
  must be physically cabled to the server.  There is also a maximum of 5
  spooled printers, but virtually no limit to the number of print queues
  available.

  Blaise Power Tools+ 5.0 is required to recompile. (Or you can write your own
  routines to replace the ones used here:

    __HiWrdSup()   - Extracts the high word from a long integer
    __LoWrdSup()   - Extracts the low word from a long integer

}
CONST
  Default_Srvr   = 'SERVER_NAME';

Type
  Printer_Type   = Record
                     ServerName  : String[48];
                     ServerID    : Byte;
                     Q_Name      : String[48];
                     Q_ID        : LongInt;
                     PortNumber  : Byte;
                   end;
Var
  Printer_Rec    : Printer_Type;
  Reg            : DOS.Registers;
  LST            : Text;


Procedure Pause;
  var
    CH  : Char;
  begin
    gotoxy(1,25); clreol;
    write('Press Any Key To Continue ');
    ch := readkey;
    gotoxy(1,25); clreol;
  end;

Procedure Reverse_Longint(var Long: Longint);
  var
    Long_Array  : array[1..4] of byte absolute Long;
    Long_Temp   : array[1..4] of byte;
    Loop        : Byte;
  begin
    For Loop := 1 to 4 do Long_Temp[Loop] := Long_Array[Loop];
    Long_Array[4] := Long_Temp[1];
    Long_Array[3] := Long_Temp[2];
    Long_Array[2] := Long_Temp[3];
    Long_Array[1] := Long_Temp[4];
  end;


Function Server_Exists(S: String; var SID: Byte): Boolean;

  { Checks that the named server exists on this network and obtains the
    offset into the Server Name Table as the ID.  If the server exists,
    this function returns TRUE
  }

  type
    Server_Lists  = Array[1..8,1..48] of char;
  var
    Server_List   : ^Server_Lists;
    A_Name        : String;
    Loop1,
    Loop2         : Byte;
  begin
    For Loop1 := 1 to length(S) do S[Loop1] := upcase(S[Loop1]);
    Reg.AH := $EF;
    Reg.AL := $04;
    intr($21,Reg);
    Server_List := ptr(Reg.ES,Reg.SI);
    Loop1 := 0;
    repeat
      inc(Loop1);
      A_Name := '';
      Loop2 := 1;
      while Server_List^[Loop1,Loop2] <> #0 do
        begin
          A_Name := A_Name + Server_List^[Loop1,Loop2];
          inc(Loop2);
        end;
    until ((A_Name = S) or (Loop1 = 8));
    if A_Name = S then
      begin
        SID := Loop1;
        Server_Exists := TRUE;
      end
    else
      begin
        SID := 0;
        Server_Exists := FALSE;
      end;
  end;


Function Q_Exists(Q: String; var Q_ID: Longint): Boolean;

  { Checks that the Print Queue Name exists on the network and obtains
    the bindery object id for the queue.  If the queue exists and
    no errors occurred, the function returns TRUE
  }

  Var
    ReqBuf   : Record
                 BufLen   : Integer;
                 SubFunc  : Byte;
                 LastSeen : Longint;
                 SrchType : Integer;
                 NameLen  : Byte;
                 ObjName  : Array[1..48] of char;
               end;
    RepBuf   : Record
                 BufLen   : Integer;
                 ObjId    : Longint;
                 ObjType  : Integer;
                 ObjName  : Array[1..48] of char;
                 ObjFlag  : Byte;
                 ObjSec   : Byte;
                 ObjProps : Byte;
               end;
    Loop     : Integer;
    BindType : Integer;
    OK       : Boolean;
    A_Queue  : String;

  begin
    BindType := 3;  { Even though Novell says this is a Print Server type }

    for Loop := 1 to length(Q) do Q[Loop] := upcase(Q[Loop]);

    fillchar(ReqBuf,Sizeof(ReqBuf),#0);
    fillchar(RepBuf,Sizeof(RepBuf),#0);

    Reg.AH := $E3;
    Reg.DS := Seg(ReqBuf);
    Reg.SI := Ofs(ReqBuf);
    Reg.ES := Seg(RepBuf);
    Reg.DI := Ofs(RepBuf);

    ReqBuf.BufLen := sizeof(ReqBuf) - 2;
    ReqBuf.SubFunc := $37;

    ReqBuf.LastSeen := -1;
    Reverse_LongInt(ReqBuf.LastSeen);

    ReqBuf.SrchType := BindType;
    ReqBuf.SrchType := swap(ReqBuf.SrchType);

    ReqBuf.NameLen := length(Q);
    for Loop := 1 to length(Q) do ReqBuf.ObjName[Loop] := Q[Loop];
    RepBuf.BufLen := sizeof(RepBuf);

    repeat
      A_Queue := '';
      intr($21,Reg);
      OK := (Reg.AL = $00);
      if OK then
        begin
          Loop := 1;
          while RepBuf.ObjName[Loop] <> #0 do
            begin
              A_Queue := A_Queue + RepBuf.ObjName[Loop];
              inc(Loop);
            end;
          ReqBuf.LastSeen := RepBuf.ObjId;
        end;
    until ((A_Queue = Q) or (NOT OK));
    if OK then
      begin
        Q_ID := RepBuf.ObjID;
        Q_Exists := TRUE;
      end
    else
      begin
        Q_ID := 0;
        Q_Exists := FALSE;
      end;
  end;

Procedure Get_Printer_Record;
  { simulates what would be stored in a printer definition file }
  var
    OK   : Boolean;
    Loop : Byte;
  begin
    clrscr;
    with Printer_Rec do
      begin

        {Get & Check Server Name}

        repeat
          OK := TRUE;
          gotoxy(1,3); clreol; write('Server Name (',Default_Srvr,'): ');
          readln(ServerName);
          for Loop := 1 to length(ServerName) do ServerName[Loop] := upcase(ServerName[Loop]);
          if length(ServerName) = 0 then ServerName := Default_Srvr;
          OK := Server_Exists(ServerName,ServerID);
          if not OK then
            begin
              gotoxy(1,23); clreol;
              write(#7,'That server does not exist on this network.');
              Pause;
              gotoxy(1,23); clreol;
            end;
        until OK;

        {Get & Check Queue Name}

        repeat
          OK := TRUE;
          gotoxy(1,5); clreol; write('       Print Queue Name: ');
          readln(Q_Name);
          For Loop := 1 to length(Q_Name) do Q_Name[Loop] := upcase(Q_Name[Loop]);
          OK := Q_Exists(Q_Name,Q_ID);
          if not OK then
            begin
              gotoxy(1,23); clreol;
              write(#7,'That queue does not exist on this network.');
              Pause;
              gotoxy(1,23); clreol;
            end;
        until OK;

        { Which LPT port in this workstation should the shell reassign to
          the print queue we just got?  If you have a local printer, don't
          use LPT1 or the local printer goes away.  LPT3 is what I always
          use.
        }

        repeat
          OK := TRUE;
          gotoxy(1,7); clreol; write(' Local Printer Port No.: ');
          readln(PortNumber);
          OK := (PortNumber in [1,2,3]);
          if not OK then
            begin
              gotoxy(1,23); clreol;
              write(#7,'Printer Port Number Must Be 1, 2 or 3.');
              Pause;
              gotoxy(1,23); clreol;
            end;
          until OK;

        gotoxy(1,20); clreol; writeln('Printing To Queue ',Q_Name,' On Server ',ServerName,'.');
      end;
  end;

Function Set_Capture_Print_Q: Boolean;

  { Sets the print queue and server for the next capture of the local LPT
    device.  If no errors were encountered, the function returns TRUE
  }

  var
    OK    : Boolean;
  begin
    Reg.AH := $B8;
    Reg.AL := $06;
    Reg.DH := Printer_Rec.PortNumber - 1;
    Reg.DL := Printer_Rec.ServerID;
    Reg.BX := __LoWrdSup(Printer_Rec.Q_ID);
    Reg.CX := __HiWrdSup(Printer_Rec.Q_ID);
    intr($21,Reg);
    Set_Capture_Print_Q := (Reg.AL = $00);
  end;

Function Set_Specific_Print_Job_Flags: Boolean;

  { This function turns off the Banner Page and the End of Job Form Feed
    for the Specified LPT Port.  If there are no errors encountered, the
    function returns TRUE
  }

  var
    ReqBuf  : Record
                Status        : Byte;
                Flags         : Byte;
              end;
  begin
    Reg.AH := $B8;
    Reg.AL := $03;
    Reg.CX := 2;  {length of buffer}
    Reg.ES := Seg(ReqBuf);
    Reg.BX := Ofs(ReqBuf);
    Reg.DH := Printer_Rec.PortNumber - 1;

    { Flag Values Are:

       $04 - Print Interrupted Capture
       $08 - Suppress Form Feed at End Of Job
       $40 - Enable Tab Expansion
       $80 - Print A Banner Page
    }

    ReqBuf.Flags := $08;
    intr($21,Reg);
    Set_Specific_Print_Job_Flags := (Reg.AL = $00);
  end;

Function Start_Specific_Capture: Boolean;
  begin
    Reg.AH := $DF;
    Reg.DL := $04;
    Reg.DH := Printer_Rec.PortNumber - 1;
    intr($21,Reg);
    Start_Specific_Capture := (Reg.AL = $00);
  end;

Function Open_LPT_Port: Boolean;
  var
    PortName : String;
  begin
    str(Printer_Rec.PortNumber,PortName);
    PortName := 'LPT'+PortName;
    {$I-}
    assign(LST,PortName);
    {$I+}
    if IOResult = 0 then
      begin
        {$I-}
        rewrite(LST);
        {$I+}
        if IOResult <> 0 then Open_LPT_Port := FALSE
        else Open_LPT_Port := TRUE;
      end
    else
      Open_LPT_Port := FALSE;
  end;

Function Begin_Qing: Boolean;

  { This function sets up a network printer for receiving text sent to the
    LST text variable.  If no errors are encountered the function returns
    TRUE.
  }

  var
    OK   : Boolean;
  begin
    OK := FALSE;
    if Set_Capture_Print_Q then
      if Set_Specific_Print_Job_Flags then
        if Start_Specific_Capture then
          if Open_LPT_Port then
            OK := TRUE;
    Begin_Qing := OK;
  end;

Function Close_LPT_Port: Boolean;

  { Closes the text variable LST and returns TRUE if no errors were
    encountered
  }

  begin
    {$I-}
    close(LST);
    {$I+}
    if IOResult = 0 then Close_LPT_Port := TRUE
    else Close_LPT_Port := FALSE;
  end;

Function End_Specific_Capture: Boolean;

  { Stops the capture for the named local port (which causes all text to
    be placed in the named print queue for printing) and returns TRUE if
    no errors were encountered.
  }

  begin
    Reg.AH := $DF;
    Reg.DL := $05;
    Reg.DH := Printer_Rec.PortNumber - 1;
    intr($21,Reg);
    End_Specific_Capture := (Reg.AL = $00);
  end;

Function End_Qing: Boolean;

  { Closes LST text variable and stops capture on the named local printer
    port.  Function returns TRUE if no errors were encountered.
  }

  var
    OK   : Boolean;
  begin
    OK := FALSE;
    if Close_LPT_Port then
      if End_Specific_Capture then
        OK := TRUE;
    End_Qing := OK;
  end;

Procedure Print_Something;
  var
    A_Line  : String;
    A_Num   : String;
    Loop    : Byte;
  begin
    gotoxy(1,14);
    clreol;
    write('Printing ');
    A_Line := 'Line xx : ABCDEFGHIJKLMNOPQRSTUVWYXYZ 0123456789 ';
    for Loop := 1 to 50 do
      begin
        str(Loop:2,A_Num);
        A_Line[6] := A_Num[1];
        A_Line[7] := A_Num[2];
        {$I-}
        writeln(LST,A_Line);    { Most common error is RunTime #152 which }
                                { means the port really was not opened b/c }
                                { of some error setting up for the queue }
        {$I+}
        if IOResult <> 0 then
          begin
            writeln('Error');
            exit;
          end;
        write('.');
      end;
  end;


BEGIN
  Get_Printer_Record;
  if End_Specific_Capture then begin { Do Nothing } end;
  if Begin_Qing then
    begin
      Print_Something;
      if End_Qing then begin end;
    end;
  Pause;
END.